perm filename GUNFAI.FAI[SYS,HE]3 blob
sn#076729 filedate 1973-12-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 FAISUM
C00005 00003 FAISUM CONT.
C00007 00004 SUMINT: MOVE -5(P)
C00008 00005 ANGDIR, ANGLE
C00009 00006 SORINT
C00010 00007 SORLOD
C00011 00008 SORBOD
C00013 00009 SORBOD CONT.
C00015 00010 SORBOD CONT.
C00017 00011 SORBOD CONT.
C00019 00012 SORBOD CONT., ANGLEN, LDIST
C00021 00013 DNEW, MALI
C00023 00014 WEIFAI
C00024 00015 LININT, PROINT
C00026 00016 PLDIS
C00028 00017 PLDIS CONT.
C00029 00018 LNINTA
C00031 00019 ARINT
C00032 00020 XREF1
C00033 00021 XREF2
C00035 00022 XREF3
C00037 00023 XREF4
C00039 00024 XREF6, XREF7, XREF8
C00041 00025 XREF6: MOVEI 1,1 LOOP(I2,1,MAXNOV,1)
C00043 00026 CONDIV, LACT
C00045 00027 LVNEXT
C00048 00028 LVNEXT CONT.
C00049 00029 LCRL, ANGSV
C00051 00030 PNTS
C00053 00031 PNTS CONT.
C00055 00032 LNES
C00057 ENDMK
C⊗;
; FAISUM
ENTRY FAISUM,SUMINT,ANGDIR,ANGLE,SORINT,SORLOD,SORBOD,ANGLEN,LCRL,LACT
ENTRY LININT,DNEW,WEIFAI,MALI,LDIST,PLDIS,ARINT,LNINTA,CONDIV,ANGSV,PNTS
ENTRY XREF1,XREF2,XREF3,XREF4,XREF5,XREF6,XREF7,XREF8,PROINT,LNES,LVNEXT
TITLE GUNFAI - FAIL CODE FOR SPEEDING UP GUNLO
P←17;
SAV: BLOCK 20 ;SAVE REGISTERS HERE AS NECESSARY
;FOR SUMS PROCEDURE
EXTERNAL IHI,IHI2,SX,SY,SX2,SY2,SXY,LEKV
E11←0
E21←1
E12←2
E22←3
H←4
H1←5
H2←6
L←7
FAISUM: MOVE [XWD 12,SAV]
BLT SAV+3
MOVE H,IHI ;LOAD REGISTERS WITH POINTERS
MOVE H1,-6(P)
MOVE L,-7(P)
MOVE H2,IHI2
L100:
EAX1: MOVE E11,.(H) ;LOAD COORDINATES - ADDRS SET BY SUMINT
EBX1: MOVE E21,.(H)
EAY1: MOVE E12,.(H)
EBY1: MOVE E22,.(H)
MOVE 10,E11 ;CALCULATE NEXT SET OF VALUES
FADR 10,E21 ;X1+X2
MOVE 11,E12
FADR 11,E22 ;Y1+Y2
MOVE 12,E11
FMPR 12,E11
MOVE 13,E21
FMPR 13,E21
FADR 12,13 ;X1↑2+X2↑2
MOVE 13,E12
FMPR 13,E12
MOVE 14,E22
FMPR 14,E22
FADR 13,14 ;Y1↑2+Y2↑2
MOVE 14,E12
FMPR 14,E11
MOVE 15,E21
FMPR 15,E22
FADR 14,15 ;X1*X2+Y1*Y2
; FAISUM CONT.
CAME H,L
JRST L1
MOVEM 10,SX ;FIRST TIME THROUGH-STORE VALUES
MOVEM 11,SY
MOVEM 12,SX2
MOVEM 13,SY2
MOVEM 14,SXY
JUMPL H1,L101 ;MORE POINTS - CONTINUE
MOVE 10,[XWD SAV,12]
BLT 10,15
PUSH P,E11 ;OTHERWISE, GET COEFS. AND RETURN
PUSH P,E12
PUSH P,E21
PUSH P,E22
PUSH P,-11(P) ;ADDRS FOR COEFS. BACK ON STACK
PUSH P,-11(P)
PUSH P,-11(P)
MOVEM H,IHI ;THIS MAY HAVE BEEN CHANGED
PUSHJ P,LEKV
SETZM 1 ;FLAG FOR IMMEDIATE EXIT
POPJ P,
L101: CAMN H,H2
JRST L11 ;WE ARE DONE
AOJA H,L100 ;OTHERWISE, INC POINTER AND RETURN FOR MORE
L1: FADRM 10,SX ;THIS WAS NOT FIRST PAIR, ADD VALUES TO SUMS
FADRM 11,SY
FADRM 12,SX2
FADRM 13,SY2
FADRM 14,SXY
JUMPL H1,L101 ;RETURN FOR MORE POINTS
L11: MOVEM H,IHI ;DONE - EXIT
MOVE 10,[XWD SAV,12]
BLT 10,15
SETOM 1 ;NO IMMEDIATE RETURN
POPJ P,
SUMINT: MOVE -5(P)
HRRM EAX2
HRRM EAX3
HRRM EAX4
HRRM EAX5
HRRM EAX6
HRRM EAX7
SOS
HRRM EAX1
MOVE -4(P)
HRRM EAY2
HRRM EAY3
HRRM EAY4
HRRM EAY5
HRRM EAY6
HRRM EAY7
SOS
HRRM EAY1
MOVE -3(P)
HRRM EBX2
HRRM EBX3
HRRM EBX5
HRRM EBX6
HRRM EBX7
HRRM EBX8
HRRM EBX9
HRRM EBX10
SOS
HRRM EBX1
MOVE -2(P)
HRRM EBY2
HRRM EBY3
HRRM EBY5
HRRM EBY6
HRRM EBY7
HRRM EBY8
HRRM EBY9
HRRM EBY10
HRRM EBY11
HRRM EBY12
SOS
HRRM EBY1
MOVE -1(P)
HRRM LE1
HRRM LE2
HRRM LE3
HRRM LE4
HRRM LE5
HRRM LE6
HRRM LE7
SUB P,[XWD 6,6]
JRST @6(P)
; ANGDIR, ANGLE
EXTERNAL ATAN2$,AMOD
ANGDIR: PUSH P,-1(P)
PUSH P,-3(P)
PUSHJ P,ATAN2$
FADR 1,[6.2832]
PUSH P,1
PUSH P,[6.2832]
PUSHJ P,AMOD
FMPR 1,[57.29]
CAML 1,[360.0]
SETZM 1
SUB P,[XWD 3,3]
JRST @3(P)
ANGLE: POP P,RET# ;SAVE RETURN ADDR
PUSHJ P,ANGDIR ;ARG ALREADY THERE - WILL REDUCE STACK BY 2
MOVEM 1,TMP# ;SAVE RESULT
PUSHJ P,ANGDIR ;ARG THERE AGAIN - REDUCE STACK BY 2 MORE
MOVNS 1
FADR 1,TMP ;COMBINE
FADR 1,[360.0]
PUSH P,1
PUSH P,[360.0]
PUSH P,RET ;PUT RETURN BACK ON STACK
JRST AMOD ;AMOD WILL RETURN FOR US
; SORINT
SORINT: MOVE -6(P)
HRRM FAX1
HRRM FAX2
HRRM FAX3
HRRM FAX4
HRRM FAX5
HRRM FAX6
MOVE -5(P)
HRRM FAY1
HRRM FAY2
HRRM FAY3
HRRM FAY4
HRRM FAY5
HRRM FAY6
MOVE -4(P)
HRRM FBX1
HRRM FBX2
HRRM FBX3
HRRM FBX4
HRRM FBX5
HRRM FBX6
MOVE -3(P)
HRRM FBY1
HRRM FBY2
HRRM FBY3
HRRM FBY4
HRRM FBY5
HRRM FBY6
MOVE -2(P)
HRRM IFO1
HRRM IFO2
HRRM IFO3
HRRM IFO4
HRRM IFO5
HRRM IFO6
HRRM IFO7
HRRM IFO8
HRRM IFO9
MOVE -1(P)
HRRM IBA1
HRRM IBA2
HRRM IBA3
HRRM IBA4
HRRM IBA5
HRRM IBA6
HRRM IBA7
HRRM IBA8
SUB P,[XWD 7,7]
JRST @7(P)
; SORLOD
EXTERNAL NOEPA
; FOR SORTED - SORINT, SORLOD, SORBOD
SORLOD: SETZM 1
CAML 1,NOEPA
POPJ P,
LE1: SETZM .(1)
FAX1: MOVE 2,.(1)
FBX1: FADR 2,.(1)
FSC 2,-1
EAX2: MOVEM 2,.(1)
FAY1: MOVE 2,.(1)
FBY1: FADR 2,.(1)
FSC 2,-1
EAY2: MOVEM 2,.(1)
MOVE 2,[1000000.]
EBX2: MOVEM 2,.(1)
EBY2: MOVEM 2,.(1)
IFO8: SETOM .(1)
IBA8: SETOM .(1)
AOJA 1,SORLOD+1
XX←0
YY←1
IP←1
DX0←2
DY0←3
DXN←4
DYN←5
DX1←6
DY1←7
DXY1←10
DXY2←11
D2←12
NEXT←13
IW←14
T←15
U←16
GRAV: 0
RDEP2: 0
DDQ: 0
FAK: 0
A1: 0
A2: 0
; SORBOD
SORBOD: HRLI 1,-6(P)
HRRI 1,GRAV
BLT 1,A2 ;GET ARGUMENTS
SUB P,[XWD 7,7]
MOVE [XWD 12,SAV]
BLT SAV+4
SOS NOEPA ;REDUCE NOEPA BY ONE FOR TESTING
SETZM IW
LP1: CAML IW,NOEPA
JRST LP1END
EAX3: MOVE XX,.(IW) ;GET CENTER POINT AND PAIR-VECTOR
EAY3: MOVE YY,.(IW)
FBX2: MOVE DX0,.(IW)
FAX2: FSBR DX0,.(IW)
FBY2: MOVE DY0,.(IW)
FAY2: FSBR DY0,.(IW)
MOVEI NEXT,1(IW)
LP100: CAMLE NEXT,NOEPA
AOJA IW,LP1
MOVE T,XX ;IS NEW PAIR INSIDE WINDOW?
EAX4: FSBR T,.(NEXT)
MOVMS T
CAMLE T,GRAV
AOJA NEXT,LP100
MOVE T,YY
EAY4: FSBR T,.(NEXT)
MOVMS T
CAMLE T,GRAV
AOJA NEXT,LP100
FBX3: MOVE DXN,.(NEXT) ;YES - COMPUTE DIRECTED DISTANCES AND UPDATE
FAX3: FSBR DXN,.(NEXT) ; MINIMA. FIRST FIND VECTOR FOR NEW PAIR
FBY3: MOVE DYN,.(NEXT)
FAY3: FSBR DYN,.(NEXT)
FBX4: MOVE DX1,.(IW)
FAX4: FSBR DX1,.(NEXT)
FMPR DX1,[3.0]
FBX5: FADR DX1,.(NEXT)
FAX5: FSBR DX1,.(IW)
FBY4: MOVE DY1,.(IW)
FAY4: FSBR DY1,.(NEXT)
FMPR DY1,[3.0]
FBY5: FADR DY1,.(NEXT)
FAY5: FSBR DY1,.(IW)
MOVE DXY1,DX1
FMPR DXY1,DXY1
; SORBOD CONT.
MOVE T,DY1
FMPR T,T
FADR DXY1,T ;DXY1←DX1↑2+DY1↑2
MOVE DXY2,DX0
FADR DXY2,DXN
FMPR DXY2,[-4.0]
FADR DXY2,DX1
FMPR DXY2,DXY2
MOVE T,DY0
FADR T,DYN
FMPR T,[-4.0]
FADR T,DY1
FMPR T,T
FADR DXY2,T ;DXY2←(DX1-4*(DX0+DXN))↑2+(DY1-4*(DY0+DYN))↑2
CAMLE DXY1,DDQ ;DIRECTED DISTANCES TOO LARGE?
CAMG DXY2,DDQ
CAIA
AOJA NEXT,LP100
MOVE T,DX0
FADR T,DXN
FMPR T,T
MOVE U,DY0
FADR U,DYN
FMPR U,U
FADR T,U
FMPR T,T
FSBR T,A2 ;D2←1 MAX (A1/(.001 MAX (((DX0+DXN)↑2+
CAMGE T,[0.001] ;(DYO+DYN)↑2)↑2-A2)))
MOVE T,[0.001]
MOVE D2,A1
FDVR D2,T
CAMGE D2,[1.0]
MOVE D2,[1.0]
FMPR D2,D2
FSBR D2,[1.0]
FMPR D2,FAK
FMPR D2,RDEP2 ;D2←RDEP2*FAK*(D2↑2-1)
FADR DXY1,D2
FADR DXY2,D2
CAMLE DXY1,DDQ ;GO THROUGH MINIMUM VALUES AND UPDATE IF NEC.
JRST L101P
EBY5: CAMLE DXY1,.(IW)
JRST L102P
IFO1: MOVEM NEXT,.(IW) ;NEW MINIMUM FOR OLD FORWARD
EBY6: MOVEM DXY1,.(IW)
L102P:
EBX5: CAMLE DXY1,.(NEXT)
JRST L101P
; SORBOD CONT.
IBA1: MOVEM IW,.(NEXT) ;NEW MINIMUM FOR NEW BACKWARD
EBX6: MOVEM DXY1,.(NEXT)
L101P: CAMLE DXY2,DDQ
AOJA NEXT,LP100
EBY7: CAMLE DXY2,.(NEXT)
JRST L103P
IFO2: MOVEM IW,.(NEXT) ;NEW MINIMUM FOR NEW FORWARD
EBY8: MOVEM DXY2,.(NEXT)
L103P:
EBX7: CAMLE DXY2,.(IW)
AOJA NEXT,LP100
IBA2: MOVEM NEXT,.(IW) ;NEW MINIMUM FOR OLD BACKWARD
EBX8: MOVEM DXY2,.(IW)
AOJA NEXT,LP100
AOJA IW,LP1
; AT THIS POINT, ALL EDGE-PAIRS HAVE BEEN EQUIPPED WITH BOTH
; BACKWARD AND FORWARD POINTERS (NOT NECESSARILY RECIPROCATED.)
; CLEAN UP THE LINKAGES, AND BREAK UP LOOPS (ALTHOUGH VERY
; UNLIKELY) AT THEIR WEAKEST LINK
I8←2
WEAK←3
IWEAK←4
ONE←5
TWO←ONE+1
LP1END: SETZM I8
MOVEI ONE,1
LP8: CAMLE I8,NOEPA ;REMEMBER, STILL DEC BY ONE
JRST LP8END
LE7: SKIPE .(I8)
AOJA I8,LP8
SETZM WEAK
MOVEI IW,(I8)
L82:
LE2: MOVEM ONE,.(IW)
IFO3: MOVE NEXT,.(IW)
JUMPL NEXT,L80+1 ;CHAIN CONTINUES?
IBA3: CAME IW,.(NEXT)
JRST L80
EBY9: CAML WEAK,.(IW) ;YES, STEP NEXT
JRST L84
MOVEI IWEAK,(IW) ;NEW MAXIMUM FOR WEAK LINK
EBY10: MOVE WEAK,.(IW)
L84: MOVEI IW,(NEXT)
CAIE IW,(I8) ;DO WE HAVE A LOOP?
JRST L82
; SORBOD CONT.
IFO4: MOVE T,.(IWEAK) ;YES, BREAK AT WEAKEST LINK
IBA4: SETOM .(T)
IFO5: SETOM .(IWEAK)
AOJA I8,LP8
L80:
IFO6: SETOM .(IW) ;NO, THERE IS A BREAK, REVERSE
MOVEI IW,(I8)
L81:
IBA5: MOVE NEXT,.(IW)
JUMPL NEXT,L83+1 ;CHAIN CONTINUES?
IFO7: CAME IW,.(NEXT)
JRST L83
MOVEI IW,(NEXT) ;YES, STEP NEXT
LE3: MOVEM ONE,.(IW)
JRST L81
L83:
IBA6: SETOM .(IW) ;BREAK IN THE BACKWARD LINKAGE-END OF CHAIN
AOJA I8,LP8
; THE FOLLOWING RECOPIES ARRAYS ACCORDING TO CONNECTIVITY
LP8END: SETZM IP
MOVEI TWO,2
SETZM IW
LP5: CAMLE IW,NOEPA
JRST LP5END
IBA7: SKIPL .(IW)
AOJA IW,LP5
MOVEI NEXT,(IW)
LE4: MOVEM ONE,.(IP)
L7:
FAX6: MOVE T,.(NEXT)
EAX5: MOVEM T,.(IP)
FAY6: MOVE T,.(NEXT)
EAY5: MOVEM T,.(IP)
FBX6: MOVE T,.(NEXT)
EBX9: MOVEM T,.(IP)
FBY6: MOVE T,.(NEXT)
EBY11: MOVEM T,.(IP)
IFO9: MOVE NEXT,.(NEXT)
JUMPL NEXT,[AOS IP
AOJA IW,LP5]
LE5: ADDM TWO,.(IP)
AOS IP
LE6: MOVEM TWO,.(IP)
JRST L7
; SORBOD CONT., ANGLEN, LDIST
LP5END: AOS NOEPA ;PUT BACK NOEPA
MOVE [XWD SAV,12]
BLT 16
JRST @7(P)
; COMPUTES ANGLE AND LENGTH FOR LINE LL
EXTERNAL SQRT$
ANGLEN: MOVE 6,-1(P) ;LL
MOVEM 6,LL
MOVEI 3,(6)
ASH 3,1 ;IV2
MOVEI 2,-1(3) ;IV2-1
XLC1: MOVE 4,.(3)
XLC2: FSBR 4,.(2) ;DX←XLCOR[IV2]-XLCOR[IV2-1]
YLC1: MOVE 5,.(3)
YLC2: FSBR 5,.(2) ;DY←YLCOR[IV2]-YLCOR[IV2-1]
PUSH P,4
PUSH P,5
FMPR 4,4
FMPR 5,5
FADR 4,5
PUSH P,4
PUSHJ P,SQRT$
MOVE 6,LL
RLN1: MOVEM 1,.(6) ;RLEN[LL]←SQRT(DX↑2+DY↑2)
PUSHJ P,ANGDIR
MOVE 6,LL
ANG1: MOVEM 1,.(6) ;ANGARG[LL]←ANGDIR(DX,DY)
SUB P,[XWD 2,2]
JRST @2(P)
; Measures distance (signed) from (X,Y) to line L.
LDIST: MOVE 2,-1(P)
CXL3: MOVE 1,.(2)
FMPR 1,-3(P)
CYL3: MOVE 3,.(2)
FMPR 3,-2(P)
CCL3: FADR 1,.(2)
FADR 1,3
SUB P,[XWD 4,4]
JRST @4(P)
; DNEW, MALI
;COMPUTES MEAN DISTANCE FROM PROJECTED LINE TO NEW POINT-PAIR
DNEW: SOS 2,-4(P)
EAX6: MOVE 1,.(2)
FMPR 1,-3(P)
EAY6: MOVE 3,.(2)
FMPR 3,-2(P)
FADR 1,3
FADR 1,-1(P)
MOVMS 1
EBX3: MOVE 3,.(2)
FMPR 3,-3(P)
EBY3: MOVE 4,.(2)
FMPR 4,-2(P)
FADR 3,4
FADR 3,-1(P)
MOVMS 3
FADR 1,3
FSC 1,-1
SUB P,[XWD 5,5]
JRST @5(P)
; FINDS EQUATION AND OTHER INFORMATION FOR INSERTED LINE LL
MALI: HRLZI 6,-5(P)
BLT 6,4
MOVE 5,
LSH 5,1 ;IV2
MOVEI 6,-1(5) ;IV2-1
XLC4: MOVEM 1,(6)
YLC4: MOVEM 2,(6)
XLC5: MOVEM 3,(5)
YLC5: MOVEM 4,(5)
POP P,RET
MOVE 5,
CXL2: MOVEI 1,.(5)
PUSH P,1
CYL2: MOVEI 1,.(5)
PUSH P,1
CCL2: MOVEI 1,.(5)
PUSH P,1
PUSHJ P,LEKV
PUSH P,RET
JRST ANGLEN
; WEIFAI
;PART OF WEIGHV PROCEDURE
EXTERNAL W, CX, CY, CL
WEIFAI: MOVE 1,-1(P)
AOS 1
LSH 1,-1 ;LL←(ISV+1)%2
MOVEM 1,LL#
RLN2: PUSH P,.(1)
PUSHJ P,SQRT$
MOVEM 1,W ;W ← SQRT(RLEN[LL])
MOVE 1,LL
CXL1: MOVE .(1)
MOVEM CX
CYL1: MOVE .(1)
MOVEM CY
CCL1: MOVE .(1)
MOVEM CL
MOVE 1,-1(P)
XLC3: MOVE .(1)
FMPR W
FADRM SX
YLC3: MOVE .(1)
FMPR W
FADRM SY
SUB P,[XWD 2,2]
JRST @2(P)
; LININT, PROINT
;INITIALIZE ARRAY ADDRESS FOR LINE-VERTEX STRUCTURE AND PROTOTYPES
LININT: SOS 1,-7(P) ;MAKE ALL ADDRESS RELATIVE TO INDEX 0
HRRM 1,CXL1
HRRM 1,CXL2
HRRM 1,CXL3
HRRM 1,CXL4
SOS 1,-6(P)
HRRM 1,CYL1
HRRM 1,CYL2
HRRM 1,CYL3
HRRM 1,CYL4
SOS 1,-5(P)
HRRM 1,CCL1
HRRM 1,CCL2
HRRM 1,CCL3
SOS 1,-4(P)
HRRM 1,ANG1
HRRM 1,ANG2
HRRM 1,ANG3
SOS 1,-3(P)
HRRM 1,RLN1
HRRM 1,RLN2
SOS 1,-2(P)
HRRM 1,XLC1
HRRM 1,XLC2
HRRM 1,XLC3
HRRM 1,XLC4
HRRM 1,XLC5
HRRM 1,XLC6
HRRM 1,XLC7
HRRM 1,XLC8
HRRM 1,XLC9
HRRM 1,XLC10
HRRM 1,XLC11
HRRM 1,XLC12
HRRM 1,XLC13
HRRM 1,XLC14
HRRM 1,XLC15
SOS 1,-1(P)
HRRM 1,YLC1
HRRM 1,YLC2
HRRM 1,YLC3
HRRM 1,YLC4
HRRM 1,YLC5
HRRM 1,YLC6
HRRM 1,YLC7
HRRM 1,YLC8
HRRM 1,YLC9
HRRM 1,YLC10
HRRM 1,YLC11
HRRM 1,YLC12
HRRM 1,YLC13
HRRM 1,YLC14
HRRM 1,YLC15
SUB P,[XWD 10,10]
JRST @10(P)
PROINT: SOS 1,-1(P)
HRRM 1,PLIN1
SUB P,[XWD 2,2]
JRST @2(P)
; PLDIS
; Finds the shortest squared distance, R, from point (X,Y) to
; line I, and the corresponding coordinates, (XL,YL), on the
; line. IW ← 1 (else 0) iff (XL,YL) is outside the line segment.
; This routine is used in the insertion package. Assumes the
; topological connectivity as reflected in the line-coordinates.
AK←0
IV←1
XC←2
YC←3
CYY←4
XX←5
YY←6
I←7
XL←10
YL←11
PLDIS: MOVE XX,-7(P)
MOVE YY,-6(P)
MOVE I,-5(P)
SETZM @-1(P)
MOVEI IV,(I)
ASH IV,1
SUBI IV,1
MOVE AK,[1000.0]
CYL4: MOVE CYY,.(I)
XLC6: MOVE XC,.(IV)
YLC6: MOVE YC,.(IV)
JUMPE CYY,.+3
CXL4: MOVN AK,.(I) ;IF CY≠0
FDVR AK,CYY ;THEN AK←-CXL[I]/CY
MOVE YL,AK
FMPR YL,YY
FSBR YL,XC
FADR YL,XX
FMPR YL,AK
FADR YL,YC
MOVE 13,AK
FMPR 13,13
FADR 13,[1.0]
FDVR YL,13 ;YL←(YC+AK*(AK*Y-XC+X))/(1.0+AK↑2)
MOVE XL,YY
FSBR XL,YL
FMPR XL,AK
FADR XL,XX ;XL ← X+AK*(Y-YL)
; PLDIS CONT.
MOVE 13,XX
FSBR 13,XL
FMPR 13,13
MOVE 14,YY
FSBR 14,YL
FMPR 14,14
FADR 13,14
MOVEM 13,@-2(P) ;R ← (X-XL)↑2+(Y-YL)↑2
AOS IV ;IV+1
MOVMS AK
CAMLE AK,[1.0]
JRST XLC7+2
MOVE 13,XL
FSBR 13,XC
MOVE 14,XL
XLC7: FSBR 14,.(IV)
JRST YLC7+1
MOVE 13,YL
FSBR 13,YC
MOVE 14,YL
YLC7: FSBR 14,.(IV)
FMPR 13,14
CAMGE 13,[-1.0]
JRST .+3
MOVEI 13,1
MOVEM 13,@-1(P)
MOVEM XL,@-4(P)
MOVEM YL,@-3(P)
SUB P,[XWD 10,10]
JRST @10(P)
; LNINTA
; MORE ADDRESS INITIALIZATION FOR LINE-VERTEX STRUCTURE
LNINTA: SOS 1,-7(P)
HRRM 1,LVC1
HRRM 1,LVC2
SOS 1,-6(P)
HRRM 1,LVI1
SOS 1,-5(P) ;RELATIVE TO INDEX 1 AGAIN
HRRM 1,XVC1
HRRM 1,XVC2
HRRM 1,XVC3
HRRM 1,XVC4
HRRM 1,XVC5
SOS 1,-4(P)
HRRM 1,YVC1
HRRM 1,YVC2
HRRM 1,YVC3
HRRM 1,YVC4
HRRM 1,YVC5
SOS 1,-3(P)
HRRM 1,LCRE1
HRRM 1,LCRE2
HRRM 1,LCRE3
HRRM 1,LCRE4
HRRM 1,LCRE5
HRRM 1,LCRE6
HRRM 1,LCRE7
HRRM 1,LCRE8
SOS 1,-2(P)
HRRM 1,LVR1
HRRM 1,LVR2
HRRM 1,LVR3
HRRM 1,LVR4
HRRM 1,LVR5
SOS 1,-1(P)
HRRM 1,LNK1
HRRM 1,LNK2
HRRM 1,LNK3
SUB P,[XWD 10,10]
JRST @10(P)
; ARINT
;INITIALIZE ADDRESSES FOR XREF ARRAYS
ARINT: SOS 1,-5(P)
HRRM 1,RK1
HRRM 1,RK2
HRRM 1,RK3
HRRM 1,RK4
HRRM 1,RK5
HRRM 1,RK6
SOS 1,-3(P)
HRRM 1,RBS1
HRRM 1,RBS2
HRRM 1,RBS3
HRRM 1,RBS4
SOS 1,-2(P)
HRRM 1,RCOL1
HRRM 1,RCOL2
HRRM 1,RCOL3
HRRM 1,RCOL4
HRRM 1,RCOL5
HRRM 1,RCOL6
HRRM 1,RCOL7
SOS 1,-1(P)
HRRM 1,IPS1
HRRM 1,IPS2
SUB P,[XWD 6,6]
JRST @6(P)
; XREF1
;FAIL CODE TO SPEED UP XREF
RCDIS: 0
RWICS: 0
RPS: 0
RIT: 0
RLCV1: 0
EXTERNAL LNCRE1,LNCRE2,MAXNOL,MAXNOV,I1,ICV1,ICV2,ISV1,ISV2,X,Y,IX1,IX2
EXTERNAL R1,R2,KARN,IDUM,IV1,IV2,IL,I2,IP1,IP2
XREF1: HRLI 1,-5(P) ;SAVE PARAMETERS FOR LATER ROUTINES
HRRI 1,RCDIS
BLT 1,RLCV1
MOVE 1,MAXNOL ;I1
JUMPLE 1,XL1+2
MOVE 2,MAXNOL ;I1*2
LSH 2,1
LCRE1: SKIPGE 3,.(1)
JRST XL1
ANDI 3,7777
CAML 3,LNCRE1
CAMLE 3,LNCRE2
JRST XL1
LNK1: SETZM .(2)
MOVEI 2,-1(2)
XCT LNK1
SOJA 2,.+2
XL1: MOVEI 2,-2(2)
SOJG 1,LCRE1
SUB P,[XWD 6,6]
JRST @6(P)
; XREF2
XREF2: SETOM 1 ;SUCCESS RETURN SET IF
MOVE 2,I1
LCRE2: SKIPG 3,.(2) ; {AC2=I1}
POPJ P,
ANDI 3,7777
CAML 3,LNCRE1
CAMLE 3,LNCRE2
POPJ P, ;¬LACT(I1) ∨
MOVEI 3,(2)
LSH 3,1 ; {AC3=ISV1←I1*2}
RK1: MOVE 4,.(3)
CAMN 4,[-1.0]
POPJ P, ; RK[ISV1]=-1 ∨
MOVEI 4,-1(3) ; {AC4=ISV1-1}
SKIPN @RPS ; (PS ∧
JRST XL2
LVR1: MOVM 5,.(3) ; ABS LVER[ISV1]≠ISV1 ∧
CAIN 5,(3)
JRST XL2
LVR2: MOVM 5,.(4) ; ABS LVER[ISV1-1]≠ISV1-1 ) ∨
CAIE 5,(4)
POPJ P,
XL2: MOVEM 3,ISV1
SKIPN @RIT ; (IT ∧ ¬(
JRST XL4
SETOM ICV1
SETZM ICV2
IPS1: MOVM 5,.(4) ; {AC5=ISV2←ABS IPS[ISV1-1] }
JUMPE 5,XL3 ; ISV2 ∧
RK2: MOVE 6,.(5)
RBS1: CAMGE 6,.(4)
JRST XL4 ; (RK[ISV2]<RBS[ISV1-1]∨
RCOL1: MOVE 7,.(5)
FSC 7,2
RBS4: CAMGE 7,.(4) ; 4*RCOL[ISV2]<RBS[ISV1-1])
JRST XL4
XL3: SETZM ICV1
SETOM ICV2
IPS2: MOVM 5,.(3) ; {AC5=ISV2←IPS[ISV1]}
JUMPE 5,[POPJ P,] ; ∨(ISV2 ∧
XCT RK2
RBS2: CAMGE 6,.(3) ; (RK[ISV2]<RBS[ISV1]∨
JRST XL4
XCT RCOL1
FSC 7,2 ; 4*RCOL[ISV2]<RBS[ISV1])
RBS3: CAML 7,.(3)
POPJ P,
XL4: SETZM 1
POPJ P,
; XREF3
XREF3: SETOM 1 ;SUCCEEDS IF
MOVE 2,I2
LCRE4: SKIPG 3,.(2) ; ¬LACT(IA)∨
POPJ P,
ANDI 3,7777
CAML 3,LNCRE1
CAMLE 3,LNCRE2
POPJ P,
LSH 2,1 ;RK[ISV2←2*I2]=-1∨
RK3: MOVE 4,.(2)
CAMN 4,[-1.0]
POPJ P,
MOVE 3,I2
CAMN 3,I1 ;I2=I1∨
POPJ P,
MOVEI 3,-1(2)
SKIPN @RPS ; PS∧
JRST XL5
LVR3: MOVM 4,.(2) ; ABS LVER[ISV2]≠ISV2∧
CAIN 4,(2)
JRST XL5
LVR4: MOVM 4,.(3) ; ABS LVER[ISV2-1]≠ISV2-1
CAIE 4,(3)
POPJ P,
XL5: MOVEM 2,ISV2
MOVE 4,ISV1
MOVEI 5,-1(4)
XLC8: PUSH P,.(5)
YLC8: PUSH P,.(5)
XLC9: PUSH P,.(4)
YLC9: PUSH P,.(4)
XLC10: PUSH P,.(3)
YLC10: PUSH P,.(3)
XLC11: PUSH P,.(2)
YLC11: PUSH P,.(2)
PUSH P,[0]
PUSHJ P,KARN
MOVEM 1,IDUM
SETZM 1
POPJ P,
; XREF4
XREF4: SETOM 1 ;SUCCESS IF
MOVE 2,IV1 ; {AC2=IV1}
MOVE 3,IV2 ; {AC3=IV2}
SKIPN @RPS ;PS ∧
JRST XL6
XCT LVR3
CAIE 3,(2) ; (ABS LVER[IV1]≠IV1 ∨
POPJ P,
XCT LVR4 ; ABS LVER[IV2]≠IV2) ∨
CAIE 4,(3)
POPJ P,
XL6: MOVE 4,R1 ; {AC4=R1}
MOVE 5,R2 ; {AC5=R2}
MOVE 6,@RIT ; IT+PS ∧
ADD 6,@RPS
JUMPE 6,XL7
RK4: CAMG 4,.(2) ; (R1>RK[IV1]∨
RK5: CAMLE 5,.(3) ; R2>RK[IV2]∨
POPJ P,
RCOL2: MOVE 6,.(2) ; R1>4*RCOL[IV1]∨
FSC 6,2
CAMLE 4,6
POPJ P,
RCOL3: MOVE 6,.(3) ; R2>4*RCOL[IV2])
FSC 6,2
CAMLE 5,6
POPJ P,
XL7: SETZM 1
MOVE 6,@RIT ; IF ¬(IT+PS)
ADD 6,@RPS
JUMPN 6,[POPJ P,]
MOVE 6,IDUM ; ∧IDUM=-1
CAME 6,[-1]
POPJ P,
RCOL4: CAMGE 4,.(2) ; R1<RCOL[IV1]∧
RCOL5: CAML 5,.(3) ; R2<RCOL[IV2] THEN
POPJ P,
LNK2: MOVEM 3,.(2)
LNK3: MOVEM 2,.(3)
RCOL6: MOVEM 4,.(2)
RCOL7: MOVEM 4,.(3)
POPJ P,
; XREF6, XREF7, XREF8
XREF5: SETOM 1 ;SUCCESS IF
MOVE 3,I1
MOVEI 2,1(3)
LSH 2,-1
LCRE3: SKIPG 4,.(2)
POPJ P,
ANDI 4,7777 ; ¬LACT(IL←(I1+1)%2)∨
CAML 4,LNCRE1
CAMLE 4,LNCRE2
POPJ P,
RK6: MOVE 4,.(3)
CAMN 4,[-1.0]
POPJ P, ; RK[I1]=-1.0 ∨
MOVE 4,@RPS
CAIGE 4,5 ; PS≥5 ∧
JRST XL8
XCT LVR4
CAIN 4,(3) ; ABS LVER[I1]≠I1
XL8: SETZM 1
MOVEM 2,IL
POPJ P,
XREF7: SETZM 1
MOVE 2,I1
MOVE 3,I2
XVC2: MOVE 4,.(2)
XVC3: FSBR 4,.(3)
FMPR 4,4
YVC2: MOVE 5,.(2)
YVC3: FSBR 5,.(3)
FMPR 5,5
FADR 4,5
CAMLE 4,RCDIS
SETOM 1
POPJ P,
XREF8: MOVE 5,I1
MOVE 4,I2
MOVE 3,ICV1
MOVE 2,ICV2
JRST XLC8
XREF6: MOVEI 1,1 ;LOOP(I2,1,MAXNOV,1)
CAMLE 1,MAXNOV
POPJ P,
PUSH P,1
MOVEM 1,I2
PUSH P,[-1]
PUSHJ P,LVNEXT ; IF LVNEXT(I2,-1)∧
JUMPE 1,[MOVE 1,I2↔AOJA 1,XREF6+1]
MOVE 1,I2
CAMN 1,@RLCV1 ; I2≠LCV1 ∧
AOJA 1,XREF6+1
CAMN 1,ICV1 ; I2≠ICV1 THEN BEGIN
AOJA 1,XREF6+1
XVC1: PUSH P,.(1) ; PLDIS(XVCOR[I2],
YVC1: PUSH P,.(1) ; YVCOR[I2],
PUSH P,IL ; IL,
PUSH P,[X] ; X,
PUSH P,[Y] ; Y,
PUSH P,[R2] ; R2,
PUSH P,[IP1] ; IP1)
PUSHJ P,PLDIS
MOVE 1,I2
MOVE 2,IP1 ; IF IP1=1 ∧
CAIE 2,1
AOJA 1,XREF6+1
MOVE 2,RWICS
FSC 2,1
CAMGE 2,R2 ; R2< 2*RWICS
AOJA 1,XREF6+1
MOVE 4,I1
XLC12: MOVE 2,.(4)
FSBR 2,X
FMPR 2,2 ; ∧ R2←(XLCOR[I1]-X)↑2
YLC12: MOVE 3,.(4) ; +(YLCOR[I1]-Y)↑2)<R1
FSBR 3,Y
FMPR 3,3
FADR 2,3
CAML 2,R1
AOJA 1,XREF6+1
MOVE 3,IP2
XLC13: MOVE 4,.(3) ; ∧ R2<(XLCOR[IP2]-X)↑2
FSBR 4,X
FMPR 4,4
YLC13: MOVE 5,.(3) ; +(YLCOR[IP2]-Y)↑2
FSBR 5,Y
FMPR 5,5
FADR 4,5
CAML 2,4
AOJA 1,XREF6+1
MOVEM 2,R1 ; THEN BEGIN R1←R2
MOVEM 1,ICV2 ; ICV2←I2
AOJA 1,XREF6+1 ; END; END
; CONDIV, LACT
;RETURNS (0,1,2) IF OUTGOING LINE-PAIRS ARE (//&DIV. //&CONV., NEITHER
CONDIV: MOVE 1,-1(P)
PLIN1: MOVE 2,.(1) ;GET ENTRY IN PLINEF
SETZM 1
AND 2,[XWD 30,30] ;GET CONV/DIV BITS FOR EACH DIRECTION
LSH 2,-3 ;MOVE TO HALF WORD BOUNDARY
HLRZ 3,2 ;SEPERATE HALVES
JRST @.+1(2) ;DECODE
JRST @LZ(3) ; RIGHT HALF = 0
JRST LC1 ; 1
JRST @LZ(3) ; 2
JRST @LT(3) ; 3
LZ: JRST LC2 ; LEFT HALF = 0
JRST LC1 ; 1
JRST LC2 ; 2
JRST LC0 ; 3
LT: JRST LC0 ; 0
JRST LC1 ; 1
JRST LC0 ; 2
JRST LC0 ; 3
LC2: SKIPA 1,[2] ;NEITHER SIDE WAS 1 OR 3
LC1: ADDI 1,1 ;AT LEAST ONE SIDE WAS 1
LC0: SUB P,[XWD 2,2] ;NEITHER SIDE WAS 1 BUT ONE SIDE WAS 3
JRST @2(P)
; Returns True iff line L is active.;
; INTERNAL SIMPLE INTEGER PROCEDURE LACT(INTEGER L);
; RETURN((IA←LCREDE[L] LAND '400000007777)≥LNCRE1∧IA≤LNCRE2);
LACT: SETOM 1
MOVE 2,-1(P)
LCRE6: SKIPG 2,.(2)
JRST LOUT
ANDI 2,7777
CAML 2,LNCRE1
CAMLE 2,LNCRE2
LOUT: SETZM 1
SUB P,[XWD 2,2]
JRST @2(P)
; LVNEXT
; Initializes to (and returns) the first s.v. under the
; c.v. LCV, iff LCV≠0.
; If LCV<0, inactive lines are included throughout the process.
; If LCV=0, LVNEXT returns the s.v. (signed) pointed to next, and
; moves the pointer.
; Temporary and permanent connections are counted alike.
; LVNEXT returns 0 iff the c.v. does not exist, or LCV>0 and the
; c.v. is inactive, or all the s.v:s have been returned already.
; IW indicates which procedure is currently calling LVNEXT.
; We may have pointers in several different vertices, from
; several procedures, at any given time. IW-codes are:
; 1 = NLINCV 2 = LVERPT 3 = KSCVCO 4 = MSCVCO
; 5 = MERCV 6 = LINDEL 8 = LCOMCV 9 = WEIGHV
;
; this routine knows that temp/perm feature not used
; If IW<0, return with first good s.v.;
IIDUM←1
NEXT←2
LVS←3
LVSAV←4
LCV←5
IW←6
TP←7
IPTR: BLOCK =9
IFLG: BLOCK =9
LVNEXT: SETZM IIDUM ; SET UP FOR NULL RETURN
MOVE IW,-1(P) ; CALLING ROUTINE INDEX
SKIPN LCV,-2(P) ; GET C.V. ID
JRST LVA ; IF ZERO, ALREADY INITIALIZED
MOVM TP,LCV ; OTHERWISE, INITIALIZE LOOP
LVI1: SKIPG NEXT,.(TP)
JRST LVOUT ; INACTIVE C.V., TAKE NULL EXIT
MOVEI LVS,(NEXT) ; THIS IS FIRST S.V. POINTER
LVD: MOVEI LVSAV,(NEXT) ; SAVE POINTER
LVR5: MOVM NEXT,.(NEXT) ; GET NEXT POINTER
JUMPL LCV,LVB ; ALL S.V.S WANTED
MOVEI TP,1(LVSAV) ; ONLY ACTIVE S.V.S WANTED
LSH TP,-1 ; COMPUTE LINE I.D.
LCRE7: SKIPG TP,.(TP) ; AND TEST IF ACTIVE
JRST LVC
ANDI TP,7777
CAML TP,LNCRE1
CAMLE TP,LNCRE2
JRST LVC
LVB: JUMPL IW,LVE ; ONLY FIRST LINE WANTED
; LVNEXT CONT.
HRRM NEXT,IPTR-1(IW) ;THIS S.V. OK, WAVE POINTERS
HRLM LVS,IPTR-1(IW)
MOVEM LCV,IFLG-1(IW)
LVE: MOVEI IIDUM,(LVSAV) ; AND RETURN THIS S.V.
LVOUT: SUB P,[XWD 3,3]
JRST @3(P)
LVA: HLRZ LVS,IPTR-1(IW) ; ENTRY WHEN ALREADY INITED
HRRZ NEXT,IPTR-1(IW) ; SET UP POINTERS
MOVE LCV,IFLG-1(IW)
LVC: CAIE NEXT,(LVS) ; END OF RING OF S.V.S?
JRST LVD ; NO - PROCESS THIS S.V.
JRST LVOUT ; YES - TAKE NULL RETURN
DEFINE DISX(X) {
FSBR X,IRX
FMPR X,DSCX
FADR X,DX
FIX X,233000}
DEFINE DISY(Y) {
FSBR Y,IRY
FMPR Y,DSCY
FADR Y,DY
FIX Y,233000}
; LCRL, ANGSV
; return LCREDE entry for line L (sign and low 4 octal digits only);
;INTERNAL SIMPLE INTEGER PROCEDURE LCRL(INTEGER L);
; RETURN(LCREDE[L] LAND '400000007777);
LCRL: MOVE 1,-1(P)
LCRE5: MOVE 1,.(1)
AND 1,[400000007777]
SUB P,[XWD 2,2]
JRST @2(P)
; Returns angle from ISV1 to ISV2, assuming they are joined;
;SIMPLE REAL PROCEDURE ANGSV(INTEGER ISV1,ISV2);
; RETURN(IF ISV1=ISV2 THEN 360. ELSE
; AMOD(ANGARG[(ISV2+1)%2]-ANGARG[(ISV1+1)%2]+
;; (IF 1 LAND ISV2 THEN 0. ELSE 180.)-
; (IF 1 LAND ISV1 THEN 0. ELSE 180.)+720.,360.));
ANGSV: MOVE 1,[360.0]
MOVE 2,-1(P)
CAMN 2,-2(P)
JRST [SUB P,[XWD 3,3]
JRST @3(P)]
MOVE 4,[720.0]
TRNN 2,1
FADR 4,[180.0]
MOVEI 2,1(2)
LSH 2,-1
ANG2: FADR 4,.(2)
MOVE 2,-2(P)
TRNN 2,1
FSBR 4,[180.0]
MOVEI 2,1(2)
LSH 2,-1
ANG3: FSBR 4,.(2)
MOVEM 4,-2(P)
MOVEM 1,-1(P)
JRST AMOD
; PNTS
EXTERNAL RPOINT,WIND,RVECT,LOCT,IAEDG,IRX,IRY,DSCX,DSCY,DRX,DRY
X1←1
Y1←2
X2←3
Y2←4
IE←5
IG←6
IB←7
IC←10
ID←11
SAVX: BLOCK 5
PNTS: MOVEI 5
ADD LOCT
CAMGE [-=510]
MOVNI =510
MOVEM TST#
MOVE DRX
FSC 233
FADR [0.5]
MOVEM DX#
MOVE DRY
FSC 233
FADR [0.5]
MOVEM DY#
MOVE IAEDG
SETZM TS#
CAIN 2
SETOM TS
SETZM IE
SETZM IG
MOVEI IB,1
MOVEM IB,SAVX+4
CAMLE IB,NOEPA
POPJ P,
EAX7: MOVE X1,.(IB)
EAY7: MOVE Y1,.(IB)
EBX10: MOVE X2,.(IB)
EBY12: MOVE Y2,.(IB)
; PNTS CONT.
DISX X1
DISY Y1
DISX X2
DISY Y2
SKIPN WIND
JRST PL1
CAML X1,[-=510]
CAILE X1,=510
JRST PL2
CAML X2,[-=510]
CAIL X2,=510
JRST PL2
CAML Y1,TST
CAILE Y1,=510
JRST PL2
CAML Y2,TST
CAILE Y2,=510
JRST PL2
PL1: MOVE IC,IE
MOVE ID,IG
MOVE IE,X1
MOVE IG,Y1
SUB X1,IC
SUB Y1,ID
PUSH P,X1
PUSH P,Y1
MOVE X1,[XWD X2,SAVX]
BLT X1,SAVX+3
PUSHJ P,RPOINT
MOVE X1,[XWD SAVX,X2]
BLT X1,IG
MOVE IC,IE
MOVE ID,IG
MOVE IE,X2
MOVE IG,Y2
SUB X2,IC
SUB Y2,ID
PUSH P,X2
PUSH P,Y2
MOVEM IE,SAVX+2
MOVEM IG,SAVX+3
MOVEI X1,RPOINT
SKIP TS
MOVEI X1,RVECT
PUSHJ P,(X1)
MOVE IE,SAVX+2
MOVE IG,SAVX+3
PL2: AOS IB,SAVX+4
JRST EAX7-2
; LNES
EXTERNAL ALINE,CVLIN
LNES: SETZM II1#
MOVE DRX
FSC 233
FADR [0.5]
MOVEM DX#
MOVE DRY
FSC 233
FADR [0.5]
MOVEM DY#
AOS 1,II1
LN1: CAMLE 1,MAXNOL ;AC1 = I1
POPJ P,
LCRE8: SKIPG 2,.(1)
AOJA 1,LN1
ANDI 2,7777
CAML 2,LNCRE1
CAMLE 2,LNCRE2
AOJA 1,LN1
MOVEI 2,(1)
LSH 2,1 ;AC2 = I2←I1*2
MOVEI 3,-1(2) ;AC3 = I2-1
SKIPN CVLIN
JRST LN2
LVC1: MOVE 4,.(3) ;AC4 = I3←LVERCO ENTRY
XVC4: MOVE 5,.(4)
YVC4: MOVE 6,.(4)
LVC2: MOVE 4,.(2)
XVC5: MOVE 7,.(4)
YVC5: MOVE 10,.(4)
JRST LN3
LN2:
XLC14: MOVE 5,.(3)
YLC14: MOVE 6,.(3)
XLC15: MOVE 7,.(2)
YLC15: MOVE 10,.(2)
LN3: DISX 5
DISY 6
DISX 7
DISY 10
PUSH P,5
PUSH P,6
PUSH P,7
PUSH P,10
MOVEM 1,II1
PUSHJ P,ALINE
JRST LN1-1
END